Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/MyWindows.p

Text File | 1994-08-29 | 13.6 KB | 372 lines | [TEXT/PJMM]

unit MyWindows;

{ Based heavilly on Dean Yu's Develop #17 code }

interface

{$IFC undefined THINK_Pascal}
    uses
        Windows, QuickDraw;
{$ENDC}

    procedure ZoomTheWindow (theWindow: WindowPtr; zoomout: boolean; idealsize: point; var unzoomed: rect);
    procedure ZoomWindowOut (theWindow: WindowPtr; idealsize: point);
    procedure GetWindowRect (theWindow: WindowPtr; var r: rect);
    procedure SetWindowRect (theWindow: WindowPtr; var r: rect);
    function GetWindowContentRegion (theWindow: WindowPtr): RgnHandle;
    function GetWindowStructureRegion (theWindow: WindowPtr): RgnHandle;
    procedure GetWindowPortRect (theWindow: WindowPtr; var portRect: rect);
    function GetWindowVisible (theWindow: WindowPtr): boolean;
    procedure GetWindowStandardState (theWindow: WindowPtr; var standardState: Rect);
    procedure SetWindowStandardState (theWindow: WindowPtr; standardState: Rect);
    procedure GetWindowUserState (theWindow: WindowPtr; var userState: Rect);
    procedure SetWindowUserState (theWindow: WindowPtr; userState: Rect);
    function TitleBarOnScreen (wp: WindowPtr): boolean;

implementation

{ Based on code by Dean Yu in Develop 17 }
{ Changes: }
{ Converted to Pascal }
{ Pass in desired window size instead of a ProcPtr to return the desired window size }
{ Removed use of DeviceLoop }
{   (DeviceLoop is System 7 dependent, and doesn't work in THINK Pascal anyway due to a bug in the interfaces }
{ Improved to handle zooming windows before they are made visible (since struct and content rgn's are empty) }

    uses
        Script, MySystemGlobals;

    const
        kNudgeSlop = 4;
        kIconSpace = 64;

{ WindowRecord accessor functions }

    function GetWindowContentRegion (theWindow: WindowPtr): RgnHandle;
    begin
        GetWindowContentRegion := WindowPeek(theWindow)^.contRgn;
    end;

    function GetWindowStructureRegion (theWindow: WindowPtr): RgnHandle;
    begin
        GetWindowStructureRegion := WindowPeek(theWindow)^.strucRgn;
    end;

    procedure GetWindowPortRect (theWindow: WindowPtr; var portRect: rect);
    begin
        portRect := WindowPeek(theWindow)^.port.portRect;
    end;

    function GetWindowVisible (theWindow: WindowPtr): boolean;
    begin
        GetWindowVisible := WindowPeek(theWindow)^.visible;
    end;

    procedure GetWindowStandardState (theWindow: WindowPtr; var standardState: Rect);
    begin
        standardState := WStateDataHandle(WindowPeek(theWindow)^.dataHandle)^^.stdState;
    end;

    procedure SetWindowStandardState (theWindow: WindowPtr; standardState: Rect);
    begin
        WStateDataHandle(WindowPeek(theWindow)^.dataHandle)^^.stdState := standardState;
    end;

    procedure GetWindowUserState (theWindow: WindowPtr; var userState: Rect);
    begin
        userState := WStateDataHandle(WindowPeek(theWindow)^.dataHandle)^^.userState;
    end;

    procedure SetWindowUserState (theWindow: WindowPtr; userState: Rect);
    begin
        WStateDataHandle(WindowPeek(theWindow)^.dataHandle)^^.userState := userState;
    end;

    procedure GetWindowRect (theWindow: WindowPtr; var r: rect);
    begin
        SetPort(theWindow);
        GetWindowPortRect(theWindow, r);
        LocalToGlobal(r.topleft);
        LocalToGlobal(r.botright);
    end;

    procedure SetWindowRect (theWindow: WindowPtr; var r: rect);
        var
            scratchRegion: rgnHandle;
            portRect: rect;
    begin
        GetWindowPortRect(theWindow, portRect);
        scratchRegion := NewRgn;
        GetClip(scratchRegion);
        ClipRect(portRect);
        EraseRect(portRect);
        SetWindowStandardState(theWindow, r);
        ZoomWindow(theWindow, inZoomOut, false);
        SetClip(scratchRegion);
        DisposeRgn(scratchRegion);
    end;

    function GetBestDevice (windowBounds: rect): GDHandle;
        var
            thisGD, bestGD: GDHandle;
            thisArea, bestArea: longInt;
            thisBounds: rect;
            dummy: boolean;
    begin
        thisGD := GetDeviceList;
        bestArea := 0;
        bestGD := GetMainDevice;
        while thisGD <> nil do begin
            if TestDeviceAttribute(thisGD, screenDevice) & TestDeviceAttribute(thisGD, screenActive) then begin
                dummy := SectRect(windowBounds, thisGD^^.gdRect, thisBounds);
                thisArea := longInt(thisBounds.right - thisBounds.left) * longInt(thisBounds.bottom - thisBounds.top);
                if thisArea > bestArea then begin
                    bestGD := thisGD;
                    bestArea := thisArea;
                end;
            end;
            thisGD := GetNextDevice(thisGD);
        end;
        GetBestDevice := bestGD;
    end;

{ Figure out how much we need to move the window to get it entirely on the monitor.  If }
{ the window wouldn’t fit completely on the monitor anyway, don’t move it at all; we’ll }
{ make it fit later on. }

    function CalculateOffsetAmount (idealStartPoint, idealEndPoint, idealOnScreenStartPoint, idealOnScreenEndPoint, screenEdge1, screenEdge2: integer): integer;
        var
            offsetAmount: integer;
    begin
    { First check to see if the window fits on the screen in this dimension. }
        if (idealStartPoint < screenEdge1) & (idealEndPoint > screenEdge2) then begin
            offsetAmount := 0;
        end
        else begin

        { Find out how much of the window lies off this screen by subtracting the amount of the window }
        { that is on the screen from the size of the entire window in this dimension. If the window }
        { is completely offscreen, the offset amount is going to be the distance from the ideal }
        { starting point to the first edge of the screen. }
            if idealOnScreenStartPoint - idealOnScreenEndPoint = 0 then begin
            { See if the window is lying to the left or above the screen }
                if idealEndPoint < screenEdge1 then begin
                    offsetAmount := screenEdge1 - idealStartPoint + kNudgeSlop;
                end
                else begin
            { Otherwise, it’s below or to the right of the screen }
                    offsetAmount := screenEdge2 - idealEndPoint - kNudgeSlop;
                end;
            end
            else begin
            { Window is already partially or completely on the screen }
                offsetAmount := (idealEndPoint - idealStartPoint) - (idealOnScreenEndPoint - idealOnScreenStartPoint);

            { If we are offscreen a little, move the window in a few more pixels from the edge of the screen. }
                if offsetAmount <> 0 then begin
                    offsetAmount := offsetAmount + kNudgeSlop;
                end;

            { Check to see which side of the screen the window was falling off of, so that it can be }
            { nudged in the opposite direction. }
                if idealEndPoint > screenEdge2 then begin
                    offsetAmount := -offsetAmount;
                end;
            end;
        end;

        CalculateOffsetAmount := offsetAmount;
    end;

    procedure AddRect (r1, r2: rect; var r: rect);
    begin
        r.top := r1.top + r2.top;
        r.bottom := r1.bottom + r2.bottom;
        r.left := r1.left + r2.left;
        r.right := r1.right + r2.right;
    end;

    procedure SubRect (r1, r2: rect; var r: rect);
    begin
        r.top := r1.top - r2.top;
        r.bottom := r1.bottom - r2.bottom;
        r.left := r1.left - r2.left;
        r.right := r1.right - r2.right;
    end;

    procedure ZoomWindowOut (theWindow: WindowPtr; idealsize: point);
        var
            screenWithLargestPartOfWindow: GDHandle;
            windowBounds: rect;
            newStandardRect: rect;
            scratchRect: rect;
            screenRect: rect;
            portRect: rect;
            contentRegionBoundingBox: rect;
            structureRegionBoundingBox: rect;
            deviceLoopRect: rect;
            scratchRegion: RgnHandle;
            structureRegion: RgnHandle;
            contentRegion: RgnHandle;
            on_main_device: boolean;
            horizontalAmountOffScreen: integer;
            verticalAmountOffScreen: integer;
            windowFrame: rect;
            dummy: boolean;
            orgrect: rect;
            zstate: integer;
    begin
        SetPort(theWindow);

        GetWindowRect(theWindow, orgrect);

        contentRegion := GetWindowContentRegion(theWindow);
        structureRegion := GetWindowStructureRegion(theWindow);
        GetWindowPortRect(theWindow, portRect);

{ If the window is invisible (or at least initially before it is ever made visible), then the content and structure }
{ regions will be empty.  In this case, we fake it out by using the portRect as the content region and 18 (hardcoded) }
{ as the titlebar height }
        if EmptyRgn(structureRegion) then begin
            scratchRect := portRect;
            LocalToGlobal(scratchRect.topleft);
            LocalToGlobal(scratchRect.botright);
            contentRegionBoundingBox := scratchRect;
            scratchRect.top := scratchRect.top - 18; { No other way of figuring out the window frame }
            structureRegionBoundingBox := scratchRect;
        end
        else begin
            contentRegionBoundingBox := contentRegion^^.rgnBBox;
            structureRegionBoundingBox := structureRegion^^.rgnBBox;
        end;

    { Determine the size of the window frame }
        windowFrame.top := structureRegionBoundingBox.top - contentRegionBoundingBox.top;
        windowFrame.left := structureRegionBoundingBox.left - contentRegionBoundingBox.left;
        windowFrame.right := structureRegionBoundingBox.right - contentRegionBoundingBox.right;
        windowFrame.bottom := structureRegionBoundingBox.bottom - contentRegionBoundingBox.bottom;

    { If the window is being zoomed into the standard state, calculate the best size }
    { to display the window’s information. }
        { Usually, we would use the content region’s bounding box to determine the monitor }
        { with largest portion of the window’s area. However, if the entire content region }
        { of the window is not on any screen, the structure region should be used instead. }
        windowBounds := contentRegionBoundingBox;
        scratchRegion := NewRgn;
        RectRgn(scratchRegion, windowBounds);
        SectRgn(GetGrayRgn, scratchRegion, scratchRegion);
        if EmptyRgn(scratchRegion) then begin
            windowBounds := structureRegionBoundingBox;
        end;
        DisposeRgn(scratchRegion);

        if has_colorQD then begin
            screenWithLargestPartOfWindow := GetBestDevice(windowBounds);
            screenRect := screenWithLargestPartOfWindow^^.gdRect;
            on_main_device := GetMainDevice = screenWithLargestPartOfWindow;
        end
        else begin
{$IFC undefined THINK_Pascal}
            screenRect := qd.screenBits.bounds;
{$ELSEC}
            screenRect := screenBits.bounds;
{$ENDC}
            on_main_device := true;
        end;

    { If the monitor being zoomed to is the main monitor, change the top of the }
        { useable screen area to avoid putting the title bar underneath the menubar. }
        if on_main_device then begin
            screenRect.top := screenRect.top + GetMBarHeight;
        end;

        { Go figure out the perfect size for the window as if we had an infinitely large }
        { screen }
    {    (*calcRoutine)((WindowPtr) theWindow, &newStandardRect);}
        SetRect(newStandardRect, 0, 0, idealsize.h, idealsize.v);

        { Anchor the new rectangle at the window’s current top left corner }
        { OffsetRect(&newStandardRect, -newStandardRect.left, -newStandardRect.top); }
        OffsetRect(newStandardRect, orgrect.left, orgrect.top);

        { newStandardRect is the ideal size for the content area. The window frame }
        { needs to be accounted for when we see if the window needs to be moved, }
        { or resized, so add in the dimensions of the window frame.}
        AddRect(newStandardRect, windowFrame, newStandardRect);

{        { If the new rectangle falls off the edge of the screen, nudge it so that it’s just }
        { on the screen. CalculateOffsetAmount determines how much of the window is offscreen. }
        dummy := SectRect(newStandardRect, screenRect, scratchRect);
        if not EqualRect(newStandardRect, scratchRect) then begin
            horizontalAmountOffScreen := CalculateOffsetAmount(newStandardRect.left, newStandardRect.right, scratchRect.left, scratchRect.right, screenRect.left, screenRect.right);
            verticalAmountOffScreen := CalculateOffsetAmount(newStandardRect.top, newStandardRect.bottom, scratchRect.top, scratchRect.bottom, screenRect.top, screenRect.bottom);
            OffsetRect(newStandardRect, horizontalAmountOffScreen, verticalAmountOffScreen);
        end;

        { If we’re still falling off the edge of the screen, that means that the perfect }
        { size is larger than the screen, so we need to shrink down the standard size }
        dummy := SectRect(newStandardRect, screenRect, scratchRect);
        if not EqualRect(newStandardRect, scratchRect) then begin

        { First shrink the width of the window. If the window is wider than the screen }
        { it is zooming to, we can just pin the standard rectangle to the edges of the }
        { screen, leaving some slop. If the window is narrower than the screen, we know }
        { we just nudged it into position, so nothing needs to be done. }
            if newStandardRect.right - newStandardRect.left > screenRect.right - screenRect.left then begin
                newStandardRect.left := screenRect.left + kNudgeSlop;

                if (on_main_device) then begin
                    newStandardRect.right := screenRect.right - kIconSpace;
                end
                else begin
                    newStandardRect.right := screenRect.right - kNudgeSlop;
                end;
            end;

            { Move in the top. Like the width of the window, nothing needs to be done unless }
            { the window is taller than the height of the screen. }
            if newStandardRect.bottom - newStandardRect.top > screenRect.bottom - screenRect.top then begin
                newStandardRect.top := screenRect.top + kNudgeSlop;
                newStandardRect.bottom := screenRect.bottom - kNudgeSlop;
            end;
        end;

        { We’ve got the best possible window position. Remove the }
        { frame, slam it into the WStateData record and let ZoomWindow }
        { take care of the rest. }
        SubRect(newStandardRect, windowFrame, newStandardRect);

        if (newStandardRect.left = orgrect.left) & (newStandardRect.top = orgrect.top) then begin
            SizeWindow(theWindow, newStandardRect.right - newStandardRect.left, newStandardRect.bottom - newStandardRect.top, true);
        end
        else begin
            SetWindowRect(theWindow, newStandardRect);
        end;
{ If the window is still anchored at the current location, then just resize it }
    end;

    procedure ZoomTheWindow (theWindow: WindowPtr; zoomout: boolean; idealsize: point; var unzoomed: rect);
    begin
        SetPort(theWindow);
        if zoomout then begin
            GetWindowRect(theWindow, unzoomed);
            ZoomWindowOut(theWindow, idealsize);
        end
        else begin
            SetWindowRect(theWindow, unzoomed);
        end;
    end;

    function TitleBarOnScreen (wp: WindowPtr): boolean;
        var
            rgn: RgnHandle;
    begin
        rgn := NewRgn;
        CopyRgn(GetWindowStructureRegion(wp), rgn);
        DiffRgn(rgn, GetWindowContentRegion(wp), rgn);
        SectRgn(rgn, GetGrayRgn, rgn);
        TitleBarOnScreen := not EmptyRgn(rgn);
        DisposeRgn(rgn);
    end;

end.